perm filename MPRNT.F4[MSS,LCS] blob
sn#145089 filedate 1975-02-08 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300 C LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00400
00500 IMPLICIT INTEGER(A-Q,S-Z)
00600 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2
00700 COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
00950 C ↓↓↓↓↓ V IS FOR READIN ONLY
01000 COMMON /ALF/INP(72),ML /XRN/RN(3000),V(1000)
01050 1 /STF/RSTFAC(-3/4),RSTJ3 /PLTR/PLT,RHT,DIS
01150 1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01250 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
01400 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01500 1,(R6,RJQ(4)),(J7,JQ(5)),(J6,JQ(4)),(R7,RJQ(5))
01600 1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
01900 DATA IP/'P'/,FA1/'( A1)'/
01910
01920 CALL PLOTS(K)
01930 23 TYPE 21
01940 21 FORMAT(' RESET BOTTOM? '$)
01950 ACCEPT FA1,K
01960 IF(K.EQ.'A')GO TO 124
01970 IF(K.EQ.'P')GO TO 123
01980 C TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
01985 GO TO 24
01990 123 JFONT=-1
02000 GO TO 23
02010 124 JFONT=0
02015 GO TO 23
02020 24 IF(K.EQ.'N')GO TO 22
02030 C 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
02040 C STARTING PEN POS.
02050 C 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
02060 TOP2=-999
02200 RNOMOV=0
02300 22 I1=0
02400 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02700 2 TOP=-999
02800 BOT=999
02900 20 PLT=0
02910 PLOTIT=0
03000 PWDS(1)=1.
03100 EDX=-1
03200 DO 1402 K=-3,4
03300 1402 RSTFAC(K)=1.
03400 M=1
03500 ITEM=0
03700 I=1
03900 GO TO 5504
04000
04100
04200 11 CALL NOTWRT
04300 57 IF(PLT)GO TO 6120
04400 ITEM=ITEM+1
04500 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
04600 IF(PLOTIT.EQ.-2)GO TO 2311
04700 CZZ PWDS(ITEM+1)=I
04800 CZZ PLT=0
05000
05100 5504 IF(I1.EQ.IP)GO TO 2311
05320 I1=IP
05340 INP(2)='X'
05400 311 JA=0
05500 IF(I1.NE.IP)GO TO 85
05600 2311 CALL PLTCMD
05700 IF(PLOTIT.EQ.0)GO TO 3005
05800 I1=IP
05900 PLOTIT=-1
06000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06200
06300 6531 M=1
06400 EDX=-1
06500 DO 5532 K=1,9
06600 5532 JQ(K)=RJQ(K)
06700 590 IF(PLOTIT.EQ.-1)GO TO 121
06800 I1=0
06900 243 R2=1.
07000 C TO RUN THROUGH DATA.
07200 R2=0
07300 R3=0
07400 R4=0
07500 TOP=-999
07600 BOT=999
07700 C GOES TO PLOTTER
07800 85 M=1
07900 I=PWDS(ITEM+1)
08000 ITEM=0
08100 8852 PLT=1
08200 EDX=0
08400 GO TO 6120
08500
08600 60 IF(JA.NE.88)GO TO 601
08700 RSTFAC(J3)=R2
08800 C FOR STAFF SIZE FACTOR WITHOUT STAFF.
08900 GO TO 57
09000 CXX601 RSTJ3=RSTFAC(J3+4)
09050 601 RSTJ3=RSTFAC(J3)
09100 5541 POS=STFF(J3)
09200 J2=ROFF(RHORZ(R2))
09300 C LINE IS DIVIDED INTO 200 POINTS.
09400 CALL CENTX
09434 C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
09468 R2=J2
09502 IF(JA.LE.2)GO TO 11
09536 551 GO TO(11,11,68,25,69, 11,81,67,25,125, 68,67),JA
09570 IF(JA.EQ.16.OR.JA.EQ.20)GO TO 116
09604 IF(JA.EQ.18)GO TO 80
09808
09842 69 CALL MAKNUM(R6)
09876 GO TO 57
09910
09944 68 CALL CLEFS
09978 GO TO 57
10012
10046 67 CALL SLUR
10080 GO TO 57
10114
10148 116 CALL ALPHA
10182 GO TO 57
10216
10250 81 CALL KSIG
10284 GO TO 57
10318
10352 80 CALL METER
10386 GO TO 57
10420
10520 125 IF(R3.EQ.0)RMOV=R8
10556 25 CALL ITMSUB
10590 C BAR LINES, BEAMS, STAFF LINES ****
10624 GO TO 57
11100
11200 3005 REWIND 21
11300 C GUARDS AGAINST LOSSAGE!
11400 PLOTIT=-2
11500 CALL IFILE(21,NAME)
11600 C JUMP TO READ BIG FILES
11700 2200 J=ITEM+1
11800 2202 READ(21),X,Y,(PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2)
11900 1 ,JA,(V(K),K=1,JA),JA,(V(K),K=1,JA),RSTFAC,STFF
12110 IF(Y.LE.2000)GO TO 3202
12120 TYPE 4202,Y
12130 STOP
12140 4202 FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
12200 3202 ITEM=ITEM+X
12300 I=Y
12400 GO TO 6531
12500 121 IF(PLOTIT.EQ.0)GO TO 5504
12600 5121 CALL PLTSRT
12700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12800 PLT=-1
12900 C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
13200 CC IF(R2.EQ.0)R2=1.
13210 CALL NOZERO(R2)
13300 DIS=R2*1.24
13400 CXX IF(R3.EQ.0)R3=R2
13500 RHT=R3*1.2
13600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13700 BOT=-BOT*RHT
13710 CX IXGP=100+BOT
13800 IF(TOP2.EQ.-999)GO TO 8121
13900 BOT=BOT+TOP2
13950 IF(TOP2.EQ.0)BOT=0
14000 GO TO 9121
14200 8121 RNOMOV=0
14228 9121 IF(R7.EQ.0)R7=RMOV
14237 C RMOV HAS INCHES FROM P8 OF STAFF 0.
14246 IF(RNOMOV.GT.1)BOT=RNOMOV
14255 RNOMOV=R6+R7*200.*R3
14273 RMOV=0
14400 C R6=1 FOR NO MOVE AT END. R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
14600 C (J4) P4=1 FOR XGP OUTPUT
14720 IF(J5.NE.0)GO TO 6120
15000 C MOVES 0 POINT OVER EACH TIME.
15200 6121 CALL PLOT(0,IFIX(BOT),-3)
15300 C MOVES PLOTTER UP IF P5=0.
15500
15600 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15700 6120 IF(M.GE.I)GO TO 7120
15800 CNT=RN(M)
15900 DO 6220 K=CNT+1,10
16000 JQ(K)=0
16100 6220 RJQ(K)=0
16200 JA=RN(M+1)
16300 M=M+2
16400 R2=RN(M)
16500 DO 9120 K=1,CNT
16600 RJQ(K)=RN(M+K)
16700 9120 JQ(K)=RJQ(K)
16800 M=CNT+M+1
17050 GO TO 60
17100
17200 7120 M=1
17300 CZ IF(EDX)GO TO 71201
17400 CZ IF(PLT.EQ.1)EDX=-1
17500 CZ PLT=0
17600 C RETURNS FOR 'SL'=SAVE LAST
17700 CZ GO TO 5504
17950 71201 A=TOP*RHT+50.*RHT
18000 IF(RNOMOV.NE.0)A=0
18100 IF(RNOMOV.GT.1)A=RNOMOV
18200 CALL PLOT(0,IFIX(A),3)
18225 IF(RNOMOV.EQ.1)GO TO 20
18237 C PRESERVES TOP AND BOT IF RNOMOV
18250 CX CALL PLOT(0,TOP+IXGP,3)
18275 TOP=A
18300 TOP2=TOP
18400 GO TO 2
18500 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
18600 C MOVES PLOTTER UP
18700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18800
19000 END